perm filename OCCULT[G,BGB]1 blob
sn#038356 filedate 1973-06-26 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00027 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
00007 00003 SUBR(OCCULT)WORLD ---------------------------------------------
00009 00004 SUBR(XYSORT)S0-------------------------------------------------
00011 00005 COPY POTENT RIGHT HALVES TO LEFT.
00013 00006 TEST FOR EMPTY WINDOWS.
00016 00007 SUBR(CLIP)-----------------------------------------------------
00019 00008 REPACK:0--------------------------------------------------------
00021 00009 SUBR(VSCAN)----------------------------------------------------
00023 00010 SUBR(ESCAN)S0--------------------------------------------------
00025 00011 SUBR(MKTJ)FOLD,EDGE ---------------------------------------------
00028 00012 SUBR(EHIDE)FACE,EDGE,VERTEX --------------------------------------
00031 00013 SUBR(VHIDE)FACE,VERTEX -----------------------------------------
00033 00014 SUBR(COMPEE)EDG1,EDG2---------------------------------------------
00036 00015 COMPARE E1 AND U1.
00039 00016 SUBR(FUDGE)VERTEX,EDGE -------------------------------------------
00041 00017 SUBR(EBREAK)EDGE -------------------------------------------------
00044 00018 SUBR(TJSCAN)------------------------------------------------------
00047 00019 SUBR(PROMUL)UF,EDGE,VERTEX----------------------------------------
00049 00020 SUBR(QEV)E,V------------------------------------------------------
00051 00021 SUBR(ZDEPTH)FACE,VERTEX ------------------------------------------
00053 00022 SUBR(KLJOTS)WORLD-------------------------------------------------
00055 00023 SUBR(KLTMPS)WORLD-------------------------------------------------
00056 00024 SUBR(VERIFY)NAME,ARGCNT ------------------------------------------
00059 00025 FDPY:------------------------------------------------------------
00061 00026 SUBR(WINDPY)S0 ---------------------------------------------------
00063 00027 SUBR(STAT)--------------------------------------------------------
00065 ENDMK
⊗;
TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
;OCCULT IS DEPENDENT ON THE WING AND EULER PRIMITIVES.
EXTERN MKB,MKF,MKE,MKV
EXTERN KLB,KLF,KLE,KLV
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
EXTERN INVERT
;LINK NAMES RELEVANT ONLY TO OCCULT.
DEFINE UFACE(Q,E)<CAR Q,7(E)> ;UBER/UNDER FACE.
DEFINE UFACE.(Q,E)<DIP Q,7(E)>
DEFINE TJ(Q,V)<CAR Q,7(V)> ;TJOINT LIST.
DEFINE TJ.(Q,V)<DIP Q,7(V)>
TJLIST:0
DEFINE VALEN(Q,V)<CAR Q,7(V)> ;VERTEX VALENCE.
DEFINE VALEN.(Q,V)<DIP Q,7(V)>
DEFINE TJOINT(Q,V)<CAR Q,2(V)> ;TJOINT RING.
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
;DIAGONOSTICS.
DECLARE{TIME1,TIME2}
WORLD:0
EXTERN EDPY,VDPY
EXTERN DPYSET,DPYBUF,DPYOUT,DPYBRT,DPYBIG,BUFDPY
EXTERN AIVECT,AVECT,FLODPY,DECDPY,DPYSTR,DTYO
DMODE:-1
ELIMIT: =12
PDLTOP:0
DEEPDL:BLOCK =1024
WNDCNT:0 ;NUMBER OF XY-SORT WINDOWS.
COMCNT:0 ;NUMBER OF EDGE-EDGE COMPARES.
;OUTER MOST WINDOW FROM PROJECTOR.
DECLARE{XPPMIN,XPPMAX,YPPMIN,YPPMAX,ZPPMIN,ZPPMAX}
DECLARE{VXMIN,VXMAX,VYMIN,VYMAX,VZMIN,VZMAX}
SUBR(OCCULT)WORLD ---------------------------------------------
BEGIN OCCULT; A HIDDEN LINE ELIMINATOR.
TDCA 1,1 ;CLEAR DIAGONOSTIC MODE ON ENTRY.
SETO 1, ;SET DIAGONOSTIC MODE ON ENTRY+1.
DAC 1,DMODE
;READ CLOCKS.
; SETZ↔TIMER↔DAC TIME1
SETZ↔MSTIME↔DAC TIME1
SETZ↔RUNTIM↔DAC TIME2
;TRY TO HIDE VERTICES THAT WERE HIDDEN BEFORE.
DZM TJLIST
DZM COMCNT↔DZM WNDCNT
LAC ARG1↔DAC WORLD
CALL(VSCAN)
;PLACE OUTERMOST WINDOW INTO THE DEEP PDL.
DZM PDLTOP
LACI 1,DEEPDL
DZM(1) ;WINDOW CUT DIRECTION.
LAC 2,ARG1
DAC 2,WORLD
PED 2,2 ;LAST POTENT EDGE.
PUSH 1,2
PUSH 1,[1] ;CURRENT EDGE COUNT.
PUSH 1,XPPMIN ;OUTER MOST WINDOW.
PUSH 1,XPPMAX
PUSH 1,YPPMIN
PUSH 1,YPPMAX
PUSH 1,2 ;ONLY EDGE IN WINDOW.
ZIP 1
;DO THIS WINDOW AND ALL ITS FRIENDS.
CALL(XYSORT,1)
CALL(TJSCAN)
CALL(STAT)
POP1J
BEND OCCULT;BGB 2/25/73 ---------------------------------------
SUBR(XYSORT)S0-------------------------------------------------
BEGIN XYSORT; DO WINDOW OR SPLIT IT IN TWO - BGB 25 FEB 1973.
ACCUMULATORS{S0,S1,S2,E,A}
;WINDOW DEEP STACK BLOCK FORMAT.
CUTFLG ←← -7 ;CUT DIRECTION SWITCH. 0 IN X. -1 IN Y.
ELAST ←← -6 ;LAST POTENT EDGE.
EDGCNT ←← -5 ;EDGE COUNT
XLO ←← -4 ;XL
XHI ←← -3 ;XH
YLO ←← -2 ;YL
YHI ←← -1 ;YH
;PUSH LATE BORN EDGES INTO THE CURRENT WINDOW.
LAC S0,ARG1 ;WINDOW POINTER.
LAC 1,EDGCNT(S0) ;EDGE COUNT.
DIP 1,1 ;XWD ECNT,,ECNT
ADDI 1,-1(S0) ;XWD ECNT,,S0+ECNT-1
LAC E,ELAST(S0) ;LAST POTENT EDGE.
L1: LAC A,E↔POTEN E,E
JUMPE E,L2
TEST E,POTENT↔GO L1
PUSH 1,E
GO L1
L2: HLRZM 1,EDGCNT(S0) ;UPDATE EDGE COUNT.
DAC A,ELAST(S0) ;UPDATE LAST POTENT EDGE.
ANDI 1,377777↔SUBI 1,DEEPDL
CAMLE 1,PDLTOP↔DAC 1,PDLTOP
GO .+6
CALL(WINDPY,ARG1)
CALL({VERIFY+2},[ASCII/XSORT/],[0])
;WINDOW ZERO POINTERS AND SIZE.
LAC S0,ARG1↔DAC S0,BEG0
LAC EDGCNT(S0)↔DAC SIZ0
LACN↔SLAC↔LAP S0↔DAC P0
LAC BEG0↔ADD SIZ0↔SOS↔DAC END0
;TEST FOR SMALL ENUF WINDOW POPULATION.
LAC SIZ0↔CAMGE ELIMIT ;THRESHOLD EDGE COUNT.
GO[CALL(ESCAN,BEG0)↔POP1J]
;COPY POTENT RIGHT HALVES TO LEFT.
LAC S0,P0
L3: LAC E,(S0)
TEST E,POTENT↔SETZ E,
DIP E,E↔DAC E,(S0)
AOBJN S0,L3
;CLIP EDGES INTO FIRST WINDOW.
XL←←13 ↔ XH←←14 ↔ YL←←15 ↔ YH←←16
L4: LAC S0,BEG0↔SLACI XLO(S0)↔LAPI XL↔BLT YH ;GET WINDOW 0.
LAC XH↔FSB XL↔CAMGE[1.0]↔POP1J
LAC YH↔FSB YL↔CAMGE[1.0]↔POP1J
LACM 1,CUTFLG(S0)↔ASH 1,1
LAC XL(1)↔FAD XH(1)
FSC -1↔DAC MID#
SKIPE CUTFLG(S0)
SKIPA YH,MID
LAC XH,MID ;MAKE WINDOW 1.
LAC[XWD XL,W1]↔BLT W1+3 ;SAVE WINDOW 1.
LAC 1,P0↔SETZ ;CLEAR INSIDER COUNT.
CAR 2,(1)↔CALL(CLIP)
ZIP(1)↔AOBJN 1,.-3
DAC SIZ1
;CLIP EDGES INTO SECOND WINDOW.
L5: LAC S0,BEG0
SLACI XLO(S0)
LAPI XL↔BLT YH ;GET WINDOW 0.
SKIPE CUTFLG(S0)
SKIPA YL,MID
LAC XL,MID ;MAKE WINDOW 2.
LAC 1,P0↔SETZ ;INSIDER EDGE COUNT.
CDR 2,(1)↔CALL(CLIP) ;LOOP EDGES,
ZAP(1)↔AOBJN 1,.-3 ;THRU CLIP.
;TEST FOR EMPTY WINDOWS.
L5A: DAC SIZ2↔ADD SIZ1
SKIPN↔POP1J ;BOTH WINDOWS EMPTY.
SKIPE SIZ1↔GO L5B ;WINDOW 1 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XLO(S0)↔LAC 1,P0↔HRLS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
L5B:
SKIPE SIZ2↔GO L6 ;WINDOW 2 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XHI(S0)↔LAC 1,P0↔HLRS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
;SETUP WINDOW POINTERS.
L6: LAC BEG0↔DAC BEG2
ADD SIZ2↔SOS↔DAC END2
ADDI 8↔DAC BEG1
ADD SIZ1↔SOS↔DAC END1
LACN SIZ2↔HRL BEG2↔MOVSM P2 ;AOBJN POINTER 2.
LACN SIZ1↔HRL BEG1↔MOVSM P1 ;AOBJN POINTER 1.
JSR REPACK
LAC S1,BEG1
LAC S2,BEG2
;SETUP WINDOW HEADER DATA.
L7: LAC ELAST(S2)↔DAC ELAST(S1) ;LAST POTENT EDGE.
SLACI XL↔LAPI XLO(S2)↔BLT YHI(S2) ;WINDOWS.
SLACI W1↔LAPI XLO(S1)↔BLT YHI(S1)
LAC SIZ1↔DAC EDGCNT(S1) ;WINDOW EDGE COUNTS.
LAC SIZ2↔DAC EDGCNT(S2)
SETCMB CUTFLG(S2)↔DAC CUTFLG(S1) ;CUT DIRECTION SWITCH.
;TWO CALLS ON XYSORT.
DAC S2,ARG1 ;CONVERT CURRENT EXECUTION TO SECOND.
CALL(XYSORT,S1) ;FIRST CALL.
GO XYSORT ;SECOND CALL.
;DATA GLOBAL TO CLIP AND REPACK.
DECLARE{BEG0,END0,SIZ0,P0}
DECLARE{BEG1,END1,SIZ1,P1}
DECLARE{BEG2,END2,SIZ2,P2}
W1:0↔0↔0↔0 ;WINDOW 1 SAVE AREA.
;2/25/73----------------------------------------------------------
SUBR(CLIP)-----------------------------------------------------
BEGIN CLIP; CLIP DETECTOR - SKIP WHEN EDGE CROSSES WINDOW.
;ARGUMENTS EXPECTED TO BE IN ACCUMULATORS XL,XH,YL,YH & 2.
ACCUMULATORS{C0,C1,C2,X0,X1,X2,Y0,Y1,Y2,XL,XH,YL,YH}
SKIPN 2↔POP0J
PVT C1,2↔LAC X1,XPP(C1)↔LAC Y1,YPP(C1)
NVT C2,2↔LAC X2,XPP(C2)↔LAC Y2,YPP(C2)
SETZB C1,C2
CAML Y1,YH↔IORI C1,8 ;NORTH.
CAMG Y1,YL↔IORI C1,4 ;SOUTH.
CAML X1,XH↔IORI C1,2 ;EAST.
CAMG X1,XL↔IORI C1,1 ;WEST.
JUMPE C1,HIT
CAML Y2,YH↔IORI C2,8 ;NORTH.
CAMG Y2,YL↔IORI C2,4 ;SOUTH.
CAML X2,XH↔IORI C2,2 ;EAST.
CAMG X2,XL↔IORI C2,1 ;WEST.
JUMPE C2,HIT
TDNE C1,C2 ;WHEN V1 & V2 ARE BEYOND THE WINDOW
POP0J ;IN THE SAME DIRECTION - EASY OUTSIDE.
L: LAC X0,X1↔FSB X0,X2↔MOVMS↔CAMGE X0,[1.0]↔GO[
LAC Y0,Y1↔FSB Y0,Y2↔MOVMS↔CAMGE Y0,[1.0]↔GO HIT↔GO .+1]
LAC X0,X1↔FAD X0,X2↔FSC X0,-1 ;MIDPOINT.
LAC Y0,Y1↔FAD Y0,Y2↔FSC Y0,-1
SETZ C0,
CAML Y0,YH↔IORI C0,8 ;NORTH.
CAMG Y0,YL↔IORI C0,4 ;SOUTH.
CAML X0,XH↔IORI C0,2 ;EAST.
CAMG X0,XL↔IORI C0,1 ;WEST.
JUMPE C0,HIT
TDNE C0,C1
GO .+5 ;FIRST HALF EASY OUT.
LAC C2,C0 ;FIRST HALF STILL IN DOUBT.
LAC X2,X0
LAC Y2,Y0↔GO L
TDNE C0,C2
POP0J ;BOTH HALVES EASY OUTSIDE.
LAC C1,C0 ;SECOND HALF STILL IN DOUBT.
LAC X1,X0
LAC Y1,Y0↔GO L
HIT: AOS↔AOS(P)↔POP0J
BEND;2/25/73------------------------------------------------------
REPACK:0;--------------------------------------------------------
BEGIN REPACK
ACCUMULATORS{LO,HI}
;PACK RIGHT HALFWORDS DOWNWARDS FORMING WINDOW 2.
LAC LO,BEG0↔LAC HI,END0
L1: CAML LO,HI↔GO L2
CDR(LO)↔SKIPE↔AOJA LO,L1 ;SCAN FOR HOLE.
CDR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DAP(LO)↔SOS HI↔AOJA LO,L1 ;PUT EDGE IN HOLE.
;PACK LEFT HALFWORDS DOWNWARDS FORMING WINDOW 1.
L2: LAC LO,BEG0↔LAC HI,END0
L3: CAML LO,HI↔GO L4
CAR(LO)↔SKIPE↔AOJA LO,L3 ;SCAN FOR HOLE.
CAR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DIP(LO)↔SOS HI↔AOJA LO,L3 ;PUT EDGE IN HOLE.
;CLEAR LEFT HALVES OF THE WINDOWS.
L4: LAC HI,END1↔LAC 1,SIZ1 ;COPY WINDOW 1 UP.
LAC LO,BEG0↔ADDI LO,-1(1)
L5: CAR(LO)↔DAPZ(HI)
SOS LO↔SOS HI↔SOJG 1,L5
LAC 1,P2↔ZIP(1)↔AOBJN 1,.-1
GO@REPACK
BEND;2/25/73-----------------------------------------------------
BEND XYSORT
SUBR(VSCAN)----------------------------------------------------
BEGIN VSCAN
ACCUMULATORS{B,F,V,X,Y,Z}
SLACI(400000)↔DAC XPPMAX↔DAC YPPMAX↔DAC ZPPMAX
SETCM↔DAC XPPMIN↔DAC YPPMIN↔DAC ZPPMIN
DZM EOWPTR ;WINDOW DOESN'T EXIST YET.
LAC B,WORLD ;FOR ALL THE BODIES OF THE WORLD.
L1: CCW B,B
TEST B,BBIT↔POP0J
LAC V,B ;FOR ALL THE VERTICES OF EACH BODY.
L2: PVT V,V
TEST V,VBIT↔GO L1
TEST V,POTENT↔GO L2
;COLLECT EXTREMA.
LAC X,XPP(V)↔CAMGE X,XPPMIN↔GO[
DAC X,XPPMIN↔DAC V,VXMIN↔GO .+1]
LAC Z,ZPP(V)↔CAMGE Z,ZPPMIN↔GO[
DAC Z,ZPPMIN↔DAC V,VZMIN↔GO .+1]
LAC Y,YPP(V)↔CAMGE Y,YPPMIN↔GO[
DAC Y,YPPMIN↔DAC V,VYMIN↔GO .+1]
LAC X,XPP(V)↔CAMLE X,XPPMAX↔GO[
DAC X,XPPMAX↔DAC V,VXMAX↔GO .+1]
LAC Y,YPP(V)↔CAMLE Y,YPPMAX↔GO[
DAC Y,YPPMAX↔DAC V,VYMAX↔GO .+1]
LAC Z,ZPP(V)↔CAMLE Z,ZPPMAX↔GO[
DAC Z,ZPPMAX↔DAC V,VZMAX↔GO .+1]
CDR F,7(V) ;PREVIOUS OVER FACE.
JUMPE F,L2
TEST F,POTENT↔GO L2
DAC V,VERT#↔DAC F,FACE#↔PUSH P,B
CALL(WITHIN,FACE,VERT)↔GO L3
L2B: CALL(ZDEPTH,FACE,VERT)↔JUMPE L3
L2C: CALL(VHIDE,FACE,VERT)
L3: POP P,B↔LAC V,VERT↔LAC F,FACE↔GO L2
LIT
BEND;2/27/73------------------------------------------------------
SUBR(ESCAN)S0--------------------------------------------------
BEGIN ESCAN; BGB - 10 FEBRUARY 1973.
ACCUMULATORS{E1,E2}
AOS WNDCNT
;DIAGONOSTIC DISPLAY WINDOW FRAME.
SKIPE DMODE↔GO[CALL(WINDPY,ARG1)
CALL({VERIFY+2},[ASCIZ/ESCAN/],[0])↔GO .+1]
;COMPARE EACH EDGE IN THE WINDOW WITH ALL THE OTHERS,
;WHEN TWO EDGES CROSS MAKE A TJOINT.
L0: LAC E1,ARG1↔DAC E1,EDG1 ;FIRST EDGE.
LAC -5(E1) ;EDGE COUNT.
CAIGE 2↔POP1J ;TAKES AT LEAST TWO.
ADD E1↔DAC EOWPTR ;END OF WINDOW.
DZM@
SOS EDG1
L1: AOS E1,EDG1↔DAC E1,EDG2
SKIPN E1,(E1)↔POP1J ;EXIT.
TEST E1,POTENT↔GO L1
L2: AOS E2,EDG2
SKIPN E2,(E2)↔GO L1
TEST E2,POTENT↔GO L2
;COMPARE EDGES.
CALL(COMPEE,@EDG1,@EDG2)
JUMPLE 1,L2
CAIN 1,441↔GO[CALL(MKTJ,@EDG1,@EDG2)↔GO L2]
GO L2
DECLARE{EDG1,EDG2}
BEND;2/10/73------------------------------------------------------
;END OF WINDOW POINTER.
EOWPTR: 0
SUBR(MKTJ)FOLD,EDGE ---------------------------------------------
BEGIN MKTJ; MAKE T-JOINT.
LAC ARG2↔DAC FOLD
LAC ARG1↔DAC EDGE
SETQ(JOT,{EBREAK,FOLD})
SETQ(JUT,{EBREAK,EDGE})
;DISTINGUISH ZPP-OVER ≥ ZPP-UNDER.
LAC 1,JUT↔LAC 2,JOT
TJOIN. 1,2↔TJOIN. 2,1
LAC 0,ZPP(1)↔CAMG 0,ZPP(2)↔GO .+7↔EXCH 1,2
DAC 1,JUT↔DAC 2,JOT
LAC EDGE↔EXCH FOLD↔DAC EDGE
MARK 1,JUTBIT↔MARK 2,JOTBIT
;ORIENT EDGES WITH RESPECT TO FOLD FACES.
LAC 1,FOLD
PFACE 0,1↔DAC FACE1
NFACE 0,1↔DAC FACE2
SLACI(POTENT)↔AND@FACE1↔AND@FACE2↔ANDCAM@JUT
SETQ(V,{OTHER,EDGE,JUT})
LAC 1,JUT↔PED 1,1↔DAC 1,EJUT
CALL(QFEV,FACE1,FOLD,V)
JUMPG 1,[LAC EDGE↔EXCH EJUT↔DAC EDGE↔GO .+1]
;HIDE UNDER EDGES.
CALL(,FACE1,EJUT,JUT)
CALL(EHIDE,FACE2,EDGE,JUT)
CALL(EHIDE)
POP2J
COMMENT . ⊗ MAKE T-JOINT MANDALA
|
|
FACE2 FOLD FACE1
|
EDGE ⊗JOT EJUT
⊗-------------⊗-|------------⊗
V JUT|
|
⊗ .
DECLARE{FOLD,EDGE,EJUT,JOT,JUT,FACE1,FACE2,V}
BEND MKTJ; BGB 14 FEB 73.-----------------------------------------
SUBR(EHIDE)FACE,EDGE,VERTEX --------------------------------------
BEGIN EHIDE; EDGE HIDE - BGB - 14 FEBRUARY 1973.
LAC 1,ARG2↔DAC 1,EDGE↔TEST 1,POTENT↔POP3J
LAC 2,ARG3↔DAC 2,FACE↔TEST 2,POTENT↔POP3J
ALT. 1,2↔PED 0,2↔DAC EDG0↔DAC EDG1
LAC ARG1↔DAC V1↔SETQ(V2,{OTHER,EDGE,V1})
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/EHIDE/],[3])↔GO .+1]
;QMASK←(IF V2=NVT(E) THEN 200 ELSE 100).
LACI 200↔LAC 1,EDGE↔NVT 1,1
CAME 1,V2↔LACI 100↔DAC QMASK
;COMPARE EDGE WITH FACE.
L1: CALL(COMPEE,EDGE,EDG1)
JUMPLE 1,L2 ;DISJOINT.
TDNE 1,QMASK↔GO L3 ;V2 TOUCHING EDG1.
TRNN 1,1↔GO L2 ;CROSSING.
;CROSSING - CONTINUE INTO NEXT FACE OR MAKE A TJOINT.
L4: CALL(OTHER,EDG1,FACE)
TEST 1,POTENT↔GO L5
ALT 0,1↔CAMN 0,EDGE↔POP3J ;DON'T VISIT SAME FACE TWICE.
LAC 0,EDGE↔ALT. 0,1
DAC 1,FACE↔LAC EDG1↔DAC EDG0
;DISJOINT - CONTINUE ON THIS FACE OR HIDE EDGE.
L2: SETQ(EDG1,{ECCW,EDG1,FACE})
CAME 1,EDG0↔GO L1
LAC 1,EDGE↔MARKZ 1,POTENT ;HIDE THIS EDGE.
CALL(DPYALL)
CALL(VHIDE,FACE,V2)↔POP3J ;HIDE ALL ITS FRIENDS.
;TOUCHING.
L3: ;OUTSTR[ASCIZ/TOUCH /]
LAC 1,EDGE↔MARKZ 1,POTENT
CALL(DPYALL)↔POP3J
;MAKE A TJOINT.
L5: LAC 1,EDGE↔MARKZ 1,POTENT
PVT 1,1↔CAME 1,V2↔GO[CALL(INVERT,EDGE)↔GO .+1]
CALL(EBREAK,EDGE)↔MARK 1,JUTBIT↔PUSH P,1 ;JOINT UNDER T.
CALL(EBREAK,EDG1)↔MARK 1,JOTBIT↔POP P,2 ;JOINT OVER T.
TJOIN. 1,2↔TJOIN. 2,1
CALL(DPYALL)↔POP3J
LIT
DECLARE{FACE,EDG0,EDG1,EDGE,V1,V2,QMASK}
BEND;2/14/73------------------------------------------------------
SUBR(VHIDE)FACE,VERTEX -----------------------------------------
BEGIN VHIDE; HIDE VERTEX V UNDER FACE F.
;VHIDE IS CALLED RECURSIVELY FROM EHIDE SO TEMPORARY CELLS FOR
;V0 AND Z-FACE ARE KEPT IN THE LEFT HALF OF ARG1 AND ARG2.
ACCUMULATORS{V,E,E0}
CDR V,ARG1↔TEST V,POTENT↔POP2J
SKIPE DMODE↔GO[
CALL(VERIFY,[ASCII/VHIDE/],[2])↔CDR V,ARG1↔GO .+1]
DIP V,ARG1 ;V0.
MARKZ V,POTENT
CDR 1,ARG2↔DAP 1,7(V) ;FACE HIDES VERTEX.
CALL(ZDEPTH,1,V)↔HLLM 1,ARG2 ;Z FACE LEVEL.
L1: CDR V,ARG1↔LAC 0,ZPP(V)↔CAML 0,ARG2↔GO L4
L2: CDR V,ARG1↔PED E,V↔DAC E,E0
L3: TEST E,POTENT↔GO[
SETQ(E,{ECCW,E,V})↔CAME E,E0↔GO L3↔GO L4]
CDR ARG2↔CALL(EHIDE,0,E,V)↔GO L2
L4: CDR V,ARG1↔TJOINT V,V↔DAP V,ARG1
SKIPN V↔POP2J
CAR ARG1↔CAME V,0↔GO L1↔POP2J ;TEST FOR V0.
LIT
BEND;2/14/73------------------------------------------------------
SUBR(COMPEE)EDG1,EDG2---------------------------------------------
BEGIN COMPEE; COMPARE EDGE-EDGE.
ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2}
COMMENT/
-1 EDGES ARE DISJOINT.
0 EDGES E1 AND E2 ARE IDENTICAL.
+441 EDGE CROSS EACH OTHER.
+110 PVT(E1) IS JOINED TO PVT(E2).
+120 PVT(E1) IS JOINED TO NVT(E2).
+210 NVT(E1) IS JOINED TO PVT(E2).
+220 NVT(E1) IS JOINED TO NVT(E2)./
DEFINE EPSLON<[0.01]>
AOS COMCNT
SETZ 1,↔LAC E1,ARG2↔LAC E2,ARG1
CAMN E1,E2↔POP2J; IDENTITY CASE.
;FETCH ENDPOINTS - RING'A'AROUND TJOINTS TO GET THE JOT.
PVT V1,E1↔NVT V2,E1
PVT U1,E2↔NVT U2,E2
TESTZ V1,JUTBIT↔GO[TJOINT V1,V1↔GO .-2]
TESTZ V2,JUTBIT↔GO[TJOINT V2,V2↔GO .-2]
TESTZ U1,JUTBIT↔GO[TJOINT U1,U1↔GO .-2]
TESTZ U2,JUTBIT↔GO[TJOINT U2,U2↔GO .-2]
;TEST FOR EDGES ALREADY HAVINGS A VERTEX OR TJOINT IN COMMON.
NIM 1,110↔CAMN V1,U1↔POP2J
NIM 1,120↔CAMN V1,U2↔POP2J
NIM 1,210↔CAMN V2,U1↔POP2J
NIM 1,220↔CAMN V2,U2↔POP2J
;THE SPAN OVERLAPPING TESTS PREVENT NASTY PARALLEL CASES.
;TEST FOR X-SPAN NOT OVERLAPPING.
LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
;TEST FOR Y-SPAN NOT OVERLAPPING.
LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[L0:
SETO 1,↔POP2J]
;COMPARE E1 AND U1.
L1: SETZ 1,↔LAC Q1,CC(E1)
LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,10
;COMPARE E1 AND U2.
LAC Q2,CC(E1)
LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,20
;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
TRO 1,40 ;E1 CROSSES E2'S LINE.
;COMPARE E2 AND V1.
LAC Q1,CC(E2)
LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
LACM Q1↔CAMG EPSLON↔TRO 1,100
;COMPARE E2 AND V2.
LAC Q2,CC(E2)
LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
LACM Q2↔CAMG EPSLON↔TRO 1,200
;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
TRO 1,400 ;E2 CROSSES E1'S LINE.
;ELIMINATE COINCIDANT EDGE-VERTEX OCCURENCES BY FUDGING.
TRNE 1,010↔GO[CALL(FUDGE,U1,E1)↔GO L1] ;U1 NEAR E1'S LINE.
TRNE 1,020↔GO[CALL(FUDGE,U2,E1)↔GO L1] ;U2 NEAR E1'S LINE.
TRNE 1,100↔GO[CALL(FUDGE,V1,E2)↔GO L1] ;V1 NEAR E2'S LINE.
TRNE 1,200↔GO[CALL(FUDGE,V2,E2)↔GO L1] ;V2 NEAR E2'S LINE.
;SOLVE FOR CROSSING LOCUS.
L2: DAC 1,AC1
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
LAC XCROSS↔FMPR[3.5]↔DAC XCRUX
LAC YCROSS↔FMPR[3.5]↔DAC YCRUX
LAC 1,AC1↔TRO 1,1↔POP2J
BEND;3/1/73-------------------------------------------------------
DECLARE{XCROSS,YCROSS,ZCROSS,XCRUX,YCRUX}
SUBR(FUDGE)VERTEX,EDGE -------------------------------------------
BEGIN FUDGE; MOVE 2D VERTEX LOCUS AWAY FROM THE EDGE ALITTLE.
EXTERN ECOEF
ACCUMULATORS{V,E}↔SAVAC(11)
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/FUDGE/],[2])↔GO .+1]
LAC V,ARG2↔LAC E,ARG1↔DAC V,VERT
LAC BB(E)↔FSC -3↔FADRM YPP(V)
LAC AA(E)↔FSC -3↔FADRM XPP(V)
PED E,V↔DAC E,E0↔DAC E,E1
L: CALL(ECOEF,E1)
SETQ(E1,{ECCW,E1,VERT})
CAME 1,E0↔GO L
GETAC(11)↔POP2J
DECLARE{E0,E1,VERT}
BEND FUDGE;BGB 3/1/73---------------------------------------------
SUBR(ZDEDGE)EDGE -------------------------------------------------
BEGIN ZDEDGE; SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
ACCUMULATORS{E,V1,V2}
LAC E,ARG1
PVT V1,E↔NVT V2,E
LACM 0,AA(E)↔LACM 1,BB(E)↔CAMGE 1,0↔GO L
;WHEN DX ≥ DY:
LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
;WHEN DY > DX:
L: LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
BEND;2/10/73------------------------------------------------------
SUBR(EBREAK)EDGE -------------------------------------------------
BEGIN EBREAK;EBREAK(EDGE) IS LIKE ESPLIT.
ACCUMULATORS{B,E,V,Q,R,ENEW,VNEW,PV,NV}
;GET ZDEPTH AT CROSSING.
CALL(ZDEDGE,ARG1)
;CREATE A NEW EDGE AND A NEW VERTEX.
CDR E,ARG1↔PVT V,E↔CCW B,E
SETQ(VNEW,{MKV,B})↔MARK VNEW,TMPBIT+POTENT
EXCH 1,TJLIST↔TJ. 1,VNEW ;CONS VNEW TO TJ LIST.
LAC XCROSS↔DAC XPP(VNEW)↔LAC XCRUX↔XDC. 0,VNEW
LAC YCROSS↔DAC YPP(VNEW)↔LAC YCRUX↔YDC. 0,VNEW
LAC ZCROSS↔DAC ZPP(VNEW)
SETQ(ENEW,{MKE,B})↔MARK ENEW,POTENT
TESTZ E,FOLDED↔GO[MARK ENEW,FOLDED↔GO .+1]
TESTZ E,DARKEN↔GO[MARK ENEW,DARKEN↔GO .+1]
;COPY EDGE COEFFICIENTS.
SLACI AA(E)↔LAPI AA(ENEW)↔BLT CC(ENEW)
LAC 8(E)↔DAC 8(ENEW)
;PLACE EDGE AT END OF POTENT EDGE LIST.
LAC 1,WORLD↔NED 2,1↔NED. ENEW,1↔POTEN. ENEW,2
SKIPN EOWPTR↔GO .+4
DAC ENEW,@EOWPTR↔AOS EOWPTR↔DZM@EOWPTR
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,ENEW
PVT. VNEW,E↔NVT. VNEW,ENEW
PFACE 0,E↔PFACE. 0,ENEW
NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
PCW 0,E↔CALL(WING,0,ENEW)
NCCW 0,E↔CALL(WING,0,ENEW)
;EDGES POINT AT EACH OTHER ACROSS VNEW.
NCCW. ENEW,E↔PCW. ENEW,E
NCW. E,ENEW↔PCCW. E,ENEW
LAC 1,VNEW↔POP1J
COMMENT . _________ __________ EBREAK MANDALA
nccw \ / pcw
\ /
+ ⊗ V
+|
| ENEW
-|
⊗ VNEW
+|
| E
-|
- ⊗
/ \
___ncw___/ \___pccw___.
BEND;2/10/73------------------------------------------------------
SUBR(TJSCAN)------------------------------------------------------
BEGIN TJSCAN; SCAN TJ LIST & PROMULAGATE UNDER FACES.
ACCUMULATORS{UF1,UF2,JUT,JOT,F1,F2,E,E1,E2,V1}
;SCAN THRU TJ-LIST FOR POTENT JUTS.
SKIPA JUT,TJLIST; ⊗V1
L1: TJ JUT,JUT; |
SKIPN JUT↔POP0J; F1 UF1 |E1
TEST JUT,JUTBIT↔GO L1; |
TEST JUT,POTENT↔GO L1; EDGE JUT ⊗JOT
PUSH P,JUT; ⊗-------------⊗-|------------⊗
; |
; F2 UF2 |E2
; |
; ⊗
;PICKUP ALL THE FRIENDS OF THE PRESENT JUT.
TJOINT JOT,JUT↔PED E1,JOT ;JOT'S EDGES.
SETQ(E2,{ECCW,E1,JOT})
SETQ(V1,{OTHER,E1,JOT})
PED E,JUT↔TEST E,POTENT↔GO[ ;POTENT JUT EDGE.
SETQ(E,{ECCW,E,JUT})↔GO .+1]
PFACE F1,E↔TEST F1,POTENT↔DZM F1 ;POTENT JUT FACES.
NFACE F2,E↔TEST F2,POTENT↔DZM F2
;FORCE ORIENTATION AS IN THE MANDALA.
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V1)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V1)↔FADR 1,0
SKIPG 1↔EXCH E1,E2
;TRY TO HIDE THE JUT.
UFACE UF1,E1↔SKIPE UF1
CAMN UF1,F1↔GO L2
CALL(ZDEPTH,UF1,JUT)↔JUMPE L2
CALL(VHIDE,UF1,JUT)↔GO L9
L2: UFACE UF2,E2↔SKIPE UF2
CAMN UF2,F2↔GO L3
CALL(ZDEPTH,UF2,JUT)↔JUMPE L3
CALL(VHIDE,UF2,JUT)↔GO L9
;PROMULGATE UNDERFACES OF THIS JOT.
L3: CALL(,F2,E2,JOT)
CALL(PROMUL,F1,E1,JOT)
CALL(PROMUL)
L9: POP P,JUT↔GO L1
BEND TJSCAN;BGB 4 MARCH 1973 -------------------------------------
SUBR(PROMUL)UF,EDGE,VERTEX----------------------------------------
BEGIN PROMUL;PROMULGATE UNDER FACE ALONG THE FOLDS.
ACCUMULATORS{A2,A3,E,V,F,JUT}
SKIPN F,ARG3↔POP3J
LAC E,ARG2↔TEST E,POTENT↔POP3J
LAC V,ARG1↔TEST V,POTENT↔POP3J
SKIPE DMODE↔GO[CALL(VERIFY,[ASCII/PROML/],[3])
LAC F,ARG3↔LAC E,ARG2↔LAC V,ARG1↔GO .+1]
;PLACE UF IN EDGE IF DIFFERENT FROM THE ONE IT MAY HAVE ALREADY.
UFACE 1,E↔CAMN 1,F↔POP3J ;CONSISTENT.
UFACE. F,E
L1: SETQ(V,{OTHER,E,V})
TESTZ V,JUTBIT↔POP3J
TESTZ V,JOTBIT↔GO L3
VALEN 0,V↔CAILE 0,3↔POP3J ;EXIT ON COMPLEX VERTICES.
;PROMULGATE UNDER FACE THRU A SIMPLE TWO FOLD VERTEX.
DAC E,1
L2: CALL(ECCW,1,V)
CAMN 1,E↔POP3J
TEST 1,FOLDED↔GO L2
GO L1
;SEE IF WE CAN WIPE THIS JOT'S JUT.
L3: TEST V,VBIT↔GO[FATAL({BUG TRAP PROMUL&L3})]
TJOINT JUT,V
TEST JUT,POTENT↔GO L2-1
PED 1,JUT
PFACE 0,1↔CAMN 0,F↔POP3J
NFACE 0,1↔CAMN 0,F↔POP3J
DAC F,ARG3↔DAC E,ARG2↔DAC V,ARG1
CALL(ZDEPTH,F,JUT)↔JUMPE POP3J.
CALL(WITHIN,F,JUT)↔POP3J
CALL(VHIDE,F,JUT)
GO PROMUL
BEND PROMUL;BGB 4 MARCH 1972 -------------------------------------
SUBR(QEV)E,V------------------------------------------------------
BEGIN QEV
ACCUMULATORS{E,V}
LAC V,ARG1
LAC E,ARG2
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
BEND;2/10/73------------------------------------------------------
SUBR(QFEV)F,E,V --------------------------------------------------
BEGIN QFEV
ACCUMULATORS{E,V}
LAC V,ARG1
LAC E,ARG2
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,ARG3↔MOVNS 1
POP3J
BEND;2/10/73------------------------------------------------------
SUBR(CROSSING)X,Y,E1,E2 ------------------------------------------
BEGIN CROSSING
ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E2,ARG1
LAC E1,ARG2
LAC YPTR,ARG3
LAC XPTR,ARG4
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(XPTR)
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(YPTR)
POP4J
BEND;2/10/73------------------------------------------------------
SUBR(ZDEPTH)FACE,VERTEX ------------------------------------------
BEGIN ZDEPTH; RETURN AC0 -1 VERTEX UNDER FACE.
ACCUMULATORS{F,V}
LAC V,ARG1
LAC F,ARG2
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
POP2J
BEND;2/10/73------------------------------------------------------
SUBR(ZDALT)FACE,XPP,YPP ------------------------------------------
BEGIN ZDALT
ACCUMULATORS{F}
LAC F,ARG3
LAC 1,KK(F)
LAC AA(F)↔FMPR ARG2↔FSBR 1,0
LAC BB(F)↔FMPR ARG1↔FSBR 1,0
FDVR 1,CC(F)
POP3J
BEND;2/10/73------------------------------------------------------
SUBR(WITHIN)FACE,VERTEX ------------------------------------------
BEGIN WITHIN
ACCUMULATORS{F,V,E,E0}
LAC F,ARG2
LAC V,ARG1
PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,POP2J. ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
AOS(P)↔POP2J ;SKIP VERTEX WITHIN FACE.
BEND;2/27/73------------------------------------------------------
SUBR(KLJOTS)WORLD-------------------------------------------------
BEGIN KLJOTS
ACCUMULATORS{B,V}
CDR B,ARG1
L1: CCW B,B↔CAMN B,ARG1↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JOTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
BEND KLJOTS; BGB 16 FEB 1973 -------------------------------------
SUBR(KLJUTS)WORLD-------------------------------------------------
BEGIN KLJUTS
ACCUMULATORS{B,V}
LAC B,ARG1
L1: CCW B,B↔CAMN B,ARG1↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V
TEST V,VBIT↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JUTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
BEND KLJUTS; 16 FEB 1973 -----------------------------------------
SUBR(KLTMPS)WORLD-------------------------------------------------
BEGIN KLTMPS; KILL ALL THE TMP VERTICES IN THE WORLD.
ACCUMULATORS{B,V,E}
LAC B,ARG1
L1: CCW B,B↔CAMN B,ARG1↔POP1J
LAC E,B
L2: NED E,E↔CAMN E,B↔GO L3-1
TEST E,TMPBIT↔GO L2
NED E,E↔PUSH P,E↔PUSH P,B
PED E,E↔CALL(KLFE,E)
POP P,B↔POP P,E↔GO L2+1
LAC V,B
L3: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L3
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L3+1
BEND KLTMPS; BGB 16 MARCH 1973 -----------------------------------
SUBR(VERIFY)NAME,ARGCNT ------------------------------------------
BEGIN VERIFY; DIAGONOSTIC DISPLAY FOR VERIFYING CORRECTNESS.
EXTERN IDPY
CALL(DPYSET,DPYBUF)
AOS STEP
CALL(AIVECT,[-=510],[-=220])
CALL(DECDPY,STEP)↔CALL(DPYSTR,{[[ASCIZ/. /]]})
LAC ARG2↔DAC NAME↔CALL(DPYSTR,[NAME])
;GET POINTER TO HIS ARGUMENTS.
LACI 16,-3(17) ;STACK POINTER TO HIS RETURN ADR.
LAC ARG1↔SUB 16,0
MOVNS↔DIP 0,16 ;AOBJN POINTER.
DAC 16,SAV#
JUMPE 0,L3 ;HE'S GOT NO ARGUMENTS.
;DISPLAY ARGUMENT LIST.
PUSH P,["("]↔SKIPA
L0: CALL(DTYO,{[","]})↔CDR 1,(16)↔CALL(IDPY,1)↔AOBJN 16,L0
CALL(DTYO,{[")"]})
LAC 16,SAV
L1: CDR 1,(16)↔JUMPE 1,L2 ;GET AN ARGUMENT.
LAC 0,(1) ;GET ITS TYPE BITS.
TLNE(FBIT)↔GO[CALL(FDPY,1)↔GO L2]
TLNE(EBIT)↔GO[CALL(EDPY,1)↔GO L2]
TLNE(VBIT)↔GO[CALL(VDPY,1)↔GO L2]
L2: AOBJN 16,L1
L3: CALL(DPYOUT,[16])
SETZ↔SKIPE RUNFLG↔GO L4
;NOT RUNNING - SINGLE STEP VERIFICATION.
INCHRW
CAIN 175↔SETOM RUNFLG
CAIL"0"↔CAILE"9"↔POP2J
ANDI 17↔LAC 1,STEP2
IMULI 1,=10↔ADD 1↔DAC STEP2
GO L3
;RUNNING UNTIL STEP2 OR CHR.
L4: SKIPE 1,STEP2↔CAMLE 1,STEP↔GO .+4
DZM STEP2↔DZM RUNFLG↔GO L3
INCHRS↔POP2J↔DZM RUNFLG↔GO L3
RUNFLG:0
NAME:0↔0
STEP:0
STEP2:0
BEND;2/24/73------------------------------------------------------
FDPY:;------------------------------------------------------------
BEGIN FDPY
LAC 1,ARG1↔DAC 1,F
PED 1,1↔DAC 1,E0↔DAC 1,E
CALL(DPYBRT,[3])
CALL(VCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AIVECT,0,1)
L: CALL(VCCW,E,F)
XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AVECT,0,1)
SETQ(E,{ECCW,E,F})
CAME 1,E0↔GO L↔CALL(DPYBRT,[2])↔POP1J
DECLARE{F,E,E0}
BEND;2/10/73------------------------------------------------------
DPYALL:;----------------------------------------------------------
BEGIN DPYALL
EXTERN AIVECT,AVECT
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
LAC 1,WORLD↔DAC 1,B
L1: LAC 1,B#↔CCW 1,1↔DAC 1,B
TEST 1,BBIT↔GO[CALL(DPYOUT,[1])↔POP0J]
DAC 1,E#↔DZM CNT#
L2: LAC 1,E↔PED 1,1↔DAC 1,E↔AOS CNT
TEST 1,EBIT↔GO L1
TEST 1,POTENT↔GO L2
PVT 2,1↔NVT 3,1
XDC 0,3↔FIXX↔PUSH P,
YDC 0,3↔FIXX↔PUSH P,
XDC 0,2↔FIXX↔PUSH P,
YDC 0,2↔FIXX↔PUSH P,
CALL(AIVECT)
CALL(AVECT)
GO L2
BEND;2/10/73------------------------------------------------------
SUBR(WINDPY)S0 ---------------------------------------------------
BEGIN WINDPY; WINDOW DISPLAY.
E←←S0←←12↔XL←←13↔XH←←14↔YL←←15↔YH←←16
CALL(DPYSET,DPYBUF)↔LAC 1,ARG1
SLACI -4(1)↔LAPI XL↔BLT YH
FMP XL,[3.5]↔FIXX XL,↔FMP YL,[3.5]↔FIXX YL,
FMP XH,[3.5]↔FIXX XH,↔FMP YH,[3.5]↔FIXX YH,
CALL(AIVECT,XL,YL)
CALL(AVECT,XH,YL)↔CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)↔CALL(AVECT,XL,YL)
CALL(DPYOUT,[14])↔CALL(DPYBRT,[5])
LAC S0,ARG1↔LACN -5(S0)↔DIP S0
SKIPE↔GO[LAC 1,(S0)↔PVT 2,1↔NVT 1,1
XDC XL,1↔YDC YL,1↔XDC XH,2↔YDC YH,2
FIXX XL,↔FIXX YL,↔FIXX XH,↔FIXX YH,
CALL(AIVECT,XL,YL)↔CALL(AVECT,XH,YH)
AOBJN S0,.↔GO .+1]
LAC 1,ARG1↔LAC E,-6(1)
L1: POTEN E,E↔JUMPE E,POP1J.
TEST E,POTENT↔GO L1
CALL(EDPY,E)↔GO L1
POP1J
BEND WINDPY;
SUBR(STAT)--------------------------------------------------------
BEGIN STAT; DISPLAY OCCULT STATISTICS.
CALL(DPYSET,BUFDPY)
; SETZ↔TIMER↔SUB TIME1↔MOVM↔FLOAT↔FDVR[60.0]↔DAC TIME1
; SETZ↔RUNTIM↔SUB TIME2↔MOVM↔FLOAT↔FDVR[1000.0]↔DAC TIME2
; FDVR TIME1↔FMPR[100.0]↔FIXX↔DAC RATIO#
SETZ↔MSTIME↔SUB TIME1↔MOVM↔FLOAT↔SKIPN↔MOVSI (0.5)↔FDVRI (1000.0)↔DAC TIME1
SETZ↔RUNTIM↔SUB TIME2↔MOVM↔FLOAT↔SKIPN↔MOVSI (0.5)↔FDVRI (1000.0)↔DAC TIME2
FDVR TIME1↔FMPR[100.0]↔FIXX↔DAC RATIO#
CALL(DPYBIG,[1])
CALL(AIVECT,[=380],[=430])
CALL(DPYSTR,{[[ASCIZ/REAL TIME /]]})
CALL(FLODPY,TIME1,[2])
CALL(AIVECT,[=380],[=410])
CALL(DPYSTR,{[[ASCIZ/RUN TIME /]]})
CALL(FLODPY,TIME2,[2])
CALL(AIVECT,[=380],[=390])
CALL(DPYSTR,{[[ASCIZ/TIME SHARE /]]})
CALL(DECDPY,RATIO)
CALL(DTYO,["%"])
CALL(AIVECT,[=150],[-=400])
CALL(DPYSTR,{[[ASCIZ/PDLTOP /]]})↔CALL(DECDPY,PDLTOP)
CALL(DPYSTR,{[[ASCIZ/ WINDOWS /]]})↔CALL(DECDPY,WNDCNT)
CALL(DPYSTR,{[[ASCIZ/ COMPARES /]]})↔CALL(DECDPY,COMCNT)
CALL(DPYBIG,[2])
CALL(DPYOUT,[16])
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
CALL(DPYOUT,[15])
CALL(DPYOUT,[14])
POP0J
LIT
BEND STAT;BGB 3/4/73----------------------------------------------
END